Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/dsp/dspgroup/macros.arc/SOURCE.ASM

Assembly Source File | 1983-11-17 | 156.2 KB | 1,956 lines

*ARRAY MACROS
*AFFECTS:   XR0, AC, T, P
*
*      ARRAY <NAME>,(<1ST DIM ARG>,<2ND DIM>,<2ND DIM ARG>, ... )
*
*ARGUMENTS MAY BE CONSTANTS OR VARIABLES
*DIMENSIONS MUST BE CONSTANTS (< 13 BITS)
*<NAME> MAY BE A CONSTANT ARRAY NAME: FOO
*       OR A VARIABLE CONTAINING A POINTER TO THE
*       ARRAY: (FOO)
*
*ARRAY LOCATION IS LEFT IN THE AC
*
       COPY MACROS.LCAC
*
ARRAY  $MACRO            A,B,T
       $IF  T.L=0        USE XR0 AS TEMP
       $ASG 'XR0' TO T.S
       $ENDIF
       $ARY2 :T:,:B:     CALL ARY2 WITH TEMP
       $IF  A.L#=0
       $IF  A.A&$POPL
       ADD :A:           ADD ARRAY OFFSET VAR
       $ELSE
       SACL :T:,0        SAVE INDEX COMP
       LCAC :A:          LOAD ARRAY ADDR :A:
       ADD  :T:,0        ADD INDEX
       $ENDIF
       $ENDIF
       $END
ARY2  $MACRO            T,A,B,C,A2,B2,C2
       $IF  B.L=0
       $IF  A.SA&$UNDF
       LACK :A:          LOAD CONST 1ST DIM :A:
       $ELSE
       LAC  :A:,0        LOAD 1ST DIM :A:
       $ENDIF
       $ELSE
       $IF  C.SA&$UNDF
       LACK :C:          LOAD CONST 2ND DIM :C:
       $ELSE
       LAC  :C:,0        LOAD 2ND DIM :C:
       $ENDIF
       $IF  A.SA&$UNDF
       CALL LTK$         LOAD CONST 1ST DIM :A:
       REF  LTK$
       DATA :A:
       $ELSE
       LT   :A:          LOAD 1ST DIM :A:
       $ENDIF
       $IF  B.SA&$UNDF
       MPYK :B:          MPY BY DIM OF :C:
       $ELSE
       MPY  :B:          MPY BY DIM OF :C:
       $ENDIF
       APAC              ADD 1ST AND 2ND DIM
       $IF  A2.L#=0
       SACL :T:,0        SAVE IN :T:
       $IF  B2.SA&$UNDF
       LACK :B2:         LOAD CONST 3RD DIM :B2:
       $ELSE
       LAC  :B2:,0       LOAD 3RD DIM :B2:
       $ENDIF
       LT   :T:          LOAD 1ST+2ND DIM
       $IF  A2.SA&$UNDF
       MPYK :A2:         MPY BY DIM OF :B2:
       $ELSE
       MPY  :A2:         MPY BY DIM OF :B2:
       $ENDIF
       APAC              1ST+2ND+3RD DIM
       $IF  C2.L#=0      IF MORE DIM, RECUR
       $ARY3             :T:,:C2:
       $ENDIF
       $ENDIF
       $ENDIF
       $END
ARY3  $MACRO            T,A,B,C
       SACL :T:,0        SAVE 1ST TO N-1TH DIM IN :T:
       $IF  B.SA&$UNDF
       LACK :B:          LOAD CONST NTH DIM :B:
       $ELSE
       LAC  :B:,0        LOAD CONST NTH DIM :B:
       $ENDIF
       LT   :T:          LOAD 1ST TO N-1TH DIM
       $IF  A.SA&$UNDF
       MPYK :A:          MPY BY DIM OF :B:
       $ELSE
       MPY  :A:          MPY BY DIM OF :B:
       $ENDIF
       APAC              SUM 1ST TO NTH DIM
       $IF  C.L#=0       IF MORE DIM, RECUR
       $ARY3             :T:,:C:
       $ENDIF
       $END
*CASE
*AFFECTS: XR0, AR1, AC, STACK
*
*CASE CONSTRUCT:
*      CASE  V,(L0,L1,L2, ... ,LN)[,T|
*      [RETURNS HERE|
*      .
*      .
*      .
*L0    [WHEN V=0|
*      RET
*L1    [WHEN V=1|
*      RET
*L2    [WHEN V=2|
*      RET
*      .
*      .
*      .
*LN    [WHEN V=N|
*      RET
*
*      V IS THE CONTROL VAR
*      T IS A TEMPORARY (DEFAULTS TO XR0)
*      L1-LN ARE LABELS
*
*      IF V CONTAINS M THEN LABEL LM IS CALLED
*      USING CALA (RETURN BY RET, AR1 IS KILLED)
*
CASE   $MACRO            A,C,B     COMPUTED GOTO
       $VAR L
       $ASG '$$LAB' TO L.S
       $ASG L.SV+1 TO L.SV    TO NEXT UNIQUE LABEL
       CALL L$:L.SV:          CALL AFTER LIST
       DATA :C:               LABEL LIST
L$:L.SV: POP                  POP LIST ADDR TO AC
       ADD  :A:,0             ADD CONTRL VAR
       $IF  B.L=0
       TBLR XR0               READ LABEL ADDR
       LAC  XR0,0             TO AC
       $ELSE
       TBLR :B:               READ LABEL TO :B:
       LAC  :B:,0             TO AC
       $ENDIF
       CALA                   CALL THE LABEL
       $END
*
*CHECK PROC NAMES
*
CHECK $MACRO            A
       $IF  A.L>4
  **ERROR** NAME IS GREATR THAN 4 CHARS
       $ENDIF
       $END
COM3  $MACRO   A,B
       $IF  A.L#=0
       $VAR Q
       $ASG '''' TO Q.S
       CSEG :Q::A::Q:    COMMON NAMED :A:
       $IF  B.L#=0
:A:    BSS  :B:          :B: WORDS NAME :A:
       $ELSE
:A:    BSS  1            1 WORD NAMED :A:
       $ENDIF
       CEND              COMMON END
       $ENDIF
       $END
*DEFINE COMMON VARS
*
*      COMMON   VAR-LIST
*
*      VAR-LIST:=VAR-ITEM!VAR-ITEM,VAR-LIST
*      VAR-ITEM:=VAR!(VAR,SIZE)
*      VAR IS VARIABLE SYMBOL
*      SIZE IS NUMBER OF WORDS TO ALLOCATE

COMMON $MACRO  A1,A2,A3,A4,A5,A6,A7,A8
       $IF     A1.L#=0
       $COM3   :A1:
       $ENDIF
       $IF     A2.L#=0
       $COM3   :A2:
       $ENDIF
       $IF     A3.L#=0
       $COM3   :A3:
       $ENDIF
       $IF     A4.L#=0
       $COM3   :A4:
       $ENDIF
       $IF     A5.L#=0
       $COM3   :A5:
       $ENDIF
       $IF     A6.L#=0
       $COM3   :A6:
       $ENDIF
       $IF     A7.L#=0
       $COM3   :A7:
       $ENDIF
       $IF     A8.L#=0
       COMMON  :A8:
       $ENDIF
       $END
*CONDITIONAL REF - REF A IF A NOT DEFINED
*
CREF  $MACRO A
       $IF  A.SA&$UNDF
       REF  :A:
       $ENDIF
       $END
*
*THIS MACRO, DDIF, CAN DO A DOT PRODUCT BETWEEN A VECTOR IN
*  DATA RAM AND CONSTANTS IN PROGRAM ROM. FORM:
*  DIF <FIRST LT POSTFIX>,<LT POSTFIX>,<RAM VECTOR>,<COEFFICIENT LIST>
*  <LT POSTFIX> IS D OR A FOR LOAD T (WITH VECTOR ELEMENTS) USING
*       LTA - ELEMENTS WILL NOT BE MOVED AS A SIDE EFFECT
*       LTD - ELEMENTS WILL BE MOVED, S0/SN MOVED TO S1/SN+1
*  <FIRST LT POSTFIX> IS LIKE <LT POSTFIX>, BUT USED ON FIRST LT
*       ONLY. SOMETIMES MAKES SENSE TO MAKE IT BLANK (AS WELL AS A OR D)
*  <RAM VECTOR> IS THE ADDRESS OF THE LAST ELEMENT IN THE VECTOR
*       (USE AR1 AND *- TO ACCESS ELEMENTS)
*  <COEFFICIENT LIST> IS AN, ... , A0, WHERE EACH IS A 13 BIT CONSTANT
*       (FROM +4095 TO -4096) - THESE ARE IN REVERSE ORDER]]]
*
*  THE FOLLOWING IS FORMED (IN THE AC):
*       P+AC+S0*A0+S1*A1+ ... +SN*AN->AC
*                   OR
*        AC+S0*A0+S1*A1+ ... +SN*AN->AC
*
*  P AND AC MUST BE PRE-INITIALIZED
*
DDIF    $MACRO P0,P,S,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9
        LARK AR1,:S:    LOAD AR1 WITH :S:
        LARP AR1        SELECT AR1
        $IF  A0.L#=0
        $1DIF :A0:,:P0:
        $ENDIF
        $IF  A1.L#=0
        $1DIF :A1:,:P:
        $ENDIF
        $IF  A2.L#=0
        $1DIF :A2:,:P:
        $ENDIF
        $IF  A3.L#=0
        $1DIF :A3:,:P:
        $ENDIF
        $IF  A4.L#=0
        $1DIF :A4:,:P:
        $ENDIF
        $IF  A5.L#=0
        $1DIF :A5:,:P:
        $ENDIF
        $IF  A6.L#=0
        $1DIF :A6:,:P:
        $ENDIF
        $IF  A7.L#=0
        $1DIF :A7:,:P:
        $ENDIF
        $IF  A8.L#=0
        $1DIF :A8:,:P:
        $ENDIF
        $IF  A9.L#=0
        $2DIF :P:,:A9:
        $ENDIF
        APAC            FLUSH TO THE AC
        $END
*DIF - DIGITAL FILTER GENERATOR
*       THE AC, P, T, AND AR1 WILL BE USED (MAYBE XR0 TOO)
*
*       DIF X,S,Y,G,RS,(A-LIST),(B-LIST)
*
*       X IS OPTIONAL INPUT VARIABLE (IF OMITTED AC ASSUMED)
*       Y IS OPTIONAL OUTPUT VARIABLE (IF OMITTED AC IS ASSUMED)
*       S IS STATE VECTOR (SHOULD HAVE ONE WORD PER A/B-LIST ENTRY)
*       G IS THE GAIN (X*G IS INPUT) -13 BIT (+4095 TO -4096)
*       RS IS THE VALUE USED TO SCALE S0 BEFORE OUTPUT (Y) CALCULATION
*               THE VALUE IS IN RIGHT SHIFTS (0 TO 16)
*       PR IS PRECISION OF THE RESULT (0 TO 16, 15, AND 12 ARE THE
*                  SIGNIFICANT VALUES WHEN USED WITH RS=12 OR 15)
*       A-LIST IS A LIST OF 13 BIT CONSTANTS, AN, ... ,A1 (REVERSE):
*               S0 := (X*G+A1*S1+A2*S2+ ... +AN*SN)/2**RS
*       B-LIST IS A LIST OF 13 BIT CONSTANTS, BN, ... ,B0 (REVERSE):
*               Y  := B0*S0+B1*S1+B2*S2+ ... +BN*SN
*               EACH SM -> SM+1 AS ACCESSED ABOVE
*
*       IF A-LIST IS BLANK, ONLY THE B-SIDE (POLES) ARE GENERATED
*               Y  := X*G+B1*S1+B2*S2+ ... +BN*SN   (B0 IS OMITTED)
*               S0 := X (OLD S0-SN-1 TO S1 TO SN)
*       IF B-LIST IS BLANK, ONLY THE A-SIDE (ZEROS) ARE GENERATED
*               S0 := (X*G+A1*S1+A2*S2+ ... +AN*SN)/2**RS
*
*       AR1 AND AR0 (IF A-LIST EMPTY ONLY) ARE DESTROYED.
*
        COPY MACROS.RLSH
*
DIF    $MACRO X,S,Y,G,RS,PR,A,B
       $IF  G.L=0
       $ASG 1 TO G.V
       $ENDIF
       $IF  G.V=1
       $IF  X.L#=0
       LAC  :X:,0      LOAD INPUT TO AC
       $IF  A.L=0
       LAR  AR0,:X:    LOAD INPUT INTO AR0
       $ENDIF
       $ELSE
       $IF  A.L=0
       SACL XR0,0      STORE AC IN TEMP
       LAR  AR0,XR0    LOAD INPUT INTO AR0
       $ENDIF
       MPYK 0          INIT P
       $ELSE
       $IF  X.L=0
       SACL XR0,0      SAVE IN TEMP
       $ASG 'XR0' TO X.S
       $ENDIF
       $IF  A.L=0
       LAR  AR0,XR0    LOAD INPUT INTO AR0
       $ENDIF
       ZAC             INIT AC
       LT   :X:        LOAD TEMP
       MPYK :G:        TIMES GAIN
       $ENDIF
       $IF  A.L#=0
       DDIF D,D,:S:+:A.V:-1,:A:
       $IF  RS.L=0     NO SHIFT
       SACL :S:,0      SAVE :S:
       $ELSE
       $IF  RS.V=16    SHIFT IS 16
       SACH :S:,0      SAVE :S:
       $ELSE
       $IF  RS.V=0     NO SHIFT
       SACL :S:,0      SAVE :S:
       $ELSE
       $IF  (RS.V=15)&(PR.V<=15)    SHIFT 15
       SACH :S:,0      SAVE WITH 15 BIT SHIFT
       $ELSE
       $IF  (RS.V=12)&(PR.V<=12)    SHIFT 12
       SACH :S:,4      SAVE WITH 12 BIT SHIFT
       $ELSE
       SACX XR0,0      SAVE WHOLE DOUBLE WORD
       RLSH XR1,:S:,:RS:
       LAC  XR0,16-:RS:
       OR   :S:
       SACL :S:,0      SAVE :S:
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $IF  B.L#=0
       ZAC             INIT AC TO ZERO
       DDIF ,A,:S:+:B.V:-1,:B:
       $ENDIF
       $ELSE
       DDIF A,D,:S:+:B.V:-1,:B:
       SAR  AR0,:S:
       $ENDIF
       $IF  Y.L#=0
       SACL :Y:,0      STORE OUTPUT
       $ENDIF
       $END
DIF1   $MACRO V,P
        LT:P: *-       LOAD THE STATE VAR
        MPYK :V:       TIMES THE COEFF
        $END
DIF2    $MACRO P,AA,B
        $1DIF  :AA:,:P:
        $IF  B.L#=0
        $2DIF :P:,:B:
        $ENDIF
        $END
*BEGIN LOOP BODY AFTER UNTIL OR WHILE
*
DO     $MACRO
       $VAR I,W
       $ASG '$$LPS' TO I.S      GET CNTXT VAR
       $ASG :I.SS: TO W.S       MAKE THIS CNTXT VAR
       :W.SS: E$:W.SV:          GEN TEST & BRANCH
       $END
DOT$   POP
       TBLR XR0
       LAR  AR0,XR0
       ADD  ONE
       TBLR XR0
       LAR  AR1,XR0
       ADD  ONE
       B    DOT$M
*COMPUTE DOT PRODUCTS
*A IS A DATA ARRAY
*B IS A DATA ARRAY
*L IS DIMENSION OF A AND B
*AC IS SET TO:
*      A[0|*B[0|+A[1|*B[1|+ ... +A[L-1|*B[L-1|
*
DOTP   $MACRO            A,B,L
       $VAR ST
       $ASG '*' TO ST.S
       $IF  A.SV#=ST.SV
       $IF  B.SV#=ST.SV
       CALL DOT$         SUM OF
       REF  DOT$
       DATA :A:           :A:
       DATA :B:           :B:
       DATA :L:          DIM :L:
       $ELSE
       CALL DOT$1        SUM OF
       REF  DOT$1
       DATA :A:           :A:
       DATA :L:          DIM :L:
       $ENDIF
       $ELSE
       $IF  B.SV#=ST.SV
       CALL DOT$0        SUM OF
       REF  DOT$0
       DATA :B:           :B:
       DATA :L:          DIM :L:
       $ELSE
       CALL DOT$01       SUM OF
       REF  DOT$01
       DATA :L:          DIM :L:
       $ENDIF
       $END
ELSE   $MACRO
       $VAR I,W
       $ASG '$$IFS' TO I.S      GET CNTEXT VAR
       $ASG :I.SS: TO W.S       MAKE THIS CNTEXT VAR
       B    B$:W.SV:            BRANCH TO ENDIF
A$:W.SV: EQU $                  BEGIN ELSE CLAUSE
       $END
ENDIF  $MACRO
       $VAR I,W,T,Q
       $ASG '$$IFS' TO I.S      GET CNTEXT VAR
       $ASG 'A$' TO Q.S
       $ASG :I.SS: TO W.S       MAKE THIS CNTEXT VAR
       $ASG :Q::W.SV: TO T.S    CHECK FOR ELSE
       $IF  T.SA&$UNDF          IF NONE, DO IT
A$:W.SV: EQU $                  DUMMY ELSE CLAUSE
       $ENDIF
B$:W.SV: EQU $                  END OF IF
       $ASG I.SV-1 TO I.SV      POP CNTEXT STACK
       $ASG '$$IF' TO Q.S
       $ASG :Q::I.SV: TO I.SS   BACK TO LAST CNTEXT VAR
       $END
*FOR LOOP
*USES: AC
*
*      FOR  I,S,E,B
*        .
*        .  [LOOP BODY|
*        .
*      NEXT
*
*INIT VARIABLE I TO S, DO BODY IF I #= E
*      S AND E ARE CONSTANTS.
*      TESTS AT THE TOP OF THE LOOP (IN THE FOR).
*      INCREMENT BY B (A + OR - CONSTANT)
*      IF B IS OMITTED, -1 IS ASSUMED.
*      IF E IS OMITTED, 1(or -1) IS ASSUMED.
*
       COPY MACROS.LCAC
       COPY MACROS.NEXT
*
FOR    $MACRO            A,S,E,B   FOR LOOP HEADER
       $IF   B.L=0       DEFLT INCR
       $ASG  '-1'  TO B.S
       $ENDIF
       $VAR I,F,Q,W,WW
       $ASG '$$LPS' TO I.S    GET LOOP CNTXT VAR
       $ASG I.SV+1 TO I.SV    PUSH CNTXT
       $ASG '$$LP' TO Q.S
       $ASG :Q::I.SV: TO I.SS MAKE THIS CNTXT VAR
       $ASG '$$LAB' TO F.S    GET LABEL CNTER
       $ASG F.SV+1 TO F.SV    INCR
       $ASG :I.SS: TO W.S     SAVE THIS CNTXT NAME
       $ASG F.SV TO W.SV      SAVE LABEL VALUE
V$:F.SV: EQU :B:              INCR VALUE
       $ASG 'V$' TO Q.S
       $ASG :Q.S::F.SV: TO WW.S
       LCAC  :S:              LOAD STRING INDEX
       B    F$:W.SV:          BEGIN TEST
I$:W.SV: EQU $                RE-LOOP ENTRY
       $IF  WW.SV=-1          IF INCR IS -1
       LAC  :A:,0             GET INDEX :A:
       SUB  ONE,0             DECR
       $ELSE
       $IF  WW.SV=1           IF INCR IS 1
       LAC  :A:,0             GET INDEX :A:
       ADD  ONE,0             INCR
       $ELSE
       LCAC :B:               GET INCR/DECR
       ADD  :A:,0             ADD TO INDEX :A:
       $ENDIF
       $ENDIF
F$:W.SV: EQU $                BEGIN TEST
       SACL :A:,0             SAVE AC TO INDEX :A:
       $IF  E.L#=0            IF E IS PRESNT
       $IF  WW.SV<0
       LCAC :E:-1             LOAD :E:+1
       $ELSE
       LCAC :E:+1
       $ENDIF
       SUB  :A:,0             COMP TO INDEX :A:
       $ENDIF
       BZ   E$:W.SV:          END LOOP WHEN :A:#=:E:
       $END
*FUNCTION DEFINITION MACRO
*      GENERATES FORMAL ARGUMENT LOCATIONS ONLY
*
*      FUNC NAME,FORMAL-LIST
*      FORMAL-LIST:=NIL!FORMAL!FORMAL,FORMAL-LIST
*      FORMAL:=VAR!(VAR,SIZE)
*
*      VAR IS VARIABLE NAME USED IN FUNCTION
*      SIZE IS THE NUMBER OF WORDS REQUIRED
*      NAME IF THE FUNCTION NAME (<4 CHARS)
*
       COPY  CHECK.SCR
       COPY  CREF.SCR
       COPY  PROC2.SCR
*
FUNC   $MACRO            A,B1,B2,B3,B4,B5,B6,B7,B8
       $CHECK :A:
       PSEG              PROG SEG
       DEF  :A:
:A:    EQU  $            ENTRY POINT
       DSEG
       $VAR L
       $ASG '$$CNTR' TO L.S
       $ASG 0 TO L.SV    INIT COUNT
       $ASG :A: TO L.SS
       $IF    B1.L#=0
       $PROC3 :B1:
       $ENDIF
       $IF    B2.L#=0
       $PROC3 :B2:
       $ENDIF
       $IF    B3.L#=0
       $PROC3 :B3:
       $ENDIF
       $IF    B4.L#=0
       $PROC3 :B4:
       $ENDIF
       $IF    B5.L#=0
       $PROC3 :B5:
       $ENDIF
       $IF    B6.L#=0
       $PROC3 :B6:
       $ENDIF
       $IF    B7.L#=0
       $PROC3 :B7:
       $ENDIF
       $IF    B8.L#=0
       $PROC2 :B8:
       $ENDIF
       DEND              END OF DATA
       $VAR P
       $ASG '$$PROC' TO P.S
       $ASG 0 TO P.SV    FLAG PROC TYPE
       $ASG :A: TO P.SS
       $END
GLB3  $MACRO   A,B
       DEF  :A:
       $IF  B.L#=0
:A:    BSS  :B:          :B: WORDS NAME :A:
       $ELSE
:A:    BSS  1            1 WORD NAMED :A:
       $ENDIF
       $END
*DEFINE GLOBAL VARS
*
*      GLOBAL VAR-LIST
*
*      VAR-LIST:=VAR-ITEM!VAR-ITEM,VAR-LIST
*      VAR-ITEM:=VAR!(VAR,SIZE)
*      VAR IS VARIABLE SYMBOL
*      SIZE IS NUMBER OF WORDS TO ALLOCATE
*
GLOBAL $MACRO  A1,A2,A3,A4,A5,A6,A7,A8
       DSEG              DATA SEG
       $IF     A1.L#=0
       $GLB3   :A1:
       $ENDIF
       $IF     A2.L#=0
       $GLB3   :A2:
       $ENDIF
       $IF     A3.L#=0
       $GLB3   :A3:
       $ENDIF
       $IF     A4.L#=0
       $GLB3   :A4:
       $ENDIF
       $IF     A5.L#=0
       $GLB3   :A5:
       $ENDIF
       $IF     A6.L#=0
       $GLB3   :A6:
       $ENDIF
       $IF     A7.L#=0
       $GLB3   :A7:
       $ENDIF
       DEND              DATA END
       $IF     A8.L#=0
       GLOBAL  :A8:
       $ENDIF
       $END
*MACROS CALLED FROM GOSUB
*
GOSB3 $MACRO            A,B
       $VAR L,P
       $ASG '$$CNTR' TO L.S        GET COUNTR
       $ASG :L.SS::L.SV: TO P.S    MAKE FORMAL NAME
       $IF  P.SA&$UNDF
       REF  :P:                    DEFINE :P: AS EXTERN
       $ENDIF
       $IF  A.SA&$UNDF             A IS A CONST
       $IF  B.L=0                  ONLY ONE CONST
       $VAR M,Q
       $ASG '$$LAB' TO M.S
V$:M.SV:    EQU :A:                COMPENSATE FOR NEG NUM
       $ASG 'V$' TO Q.S
       $ASG :Q.S::M.SV: TO A.S
       $ASG M.SV+1 TO M.SV
       $IF  (A.SV<256)&(A.SV>-1)
       LACK :A:                    ACC := 8 BIT CONST
       $ELSE
       REF  LDAC$                  ACC := 16 BIT CONST
       CALL LDAC$
       DATA :A:
       $ENDIF
       SACL :P:                    SAVE IN :P:
       $ELSE                       MORE THAN ONE CONST
       $IF  B.A&$POPL              MORE THAN TWO CONST
       $ASG B.V+1 TO L.V
       $ELSE
       $ASG 2 TO L.V               L.V = # OF CONST
       $ENDIF
       REF  MOVC$
       CALL MOVC$                  CALL CONST MOVER
       DATA :P:                    TO :P:
       DATA :L.V:                  FOR :L.V: WORDS
       DATA :A:,:B:                THE DATA
       $ENDIF
       $ELSE                       A IS A VARIABLE
       $IF  B.V<2                  SINGLE SYMBOL
       LAC  :A:,0                  LOAD :A:
       SACL :P:,0                  SAVE FOR SUBR IN :P:
       $ELSE
       REF  MOVAB$
       CALL MOVAB$                 CALL MOVER
       DATA :A:                    FROM :A:
       DATA :P:                    TO :P:
       DATA :B.V:                  FOR :B.V: WORDS
       $ENDIF
       $ENDIF
       $ASG L.SV+1 TO L.SV         TO NEXT ARG
       $END
GOSB5 $MACRO            A,B
       $VAR L,P
       $ASG '$$CNTR' TO L.S        TO COUNTR
       $IF  A.L#=0                 NON-BLANK
       $ASG :L.SS::L.SV: TO P.S    MAKE FORMAL NAME
       $IF  P.SA&$UNDF
       REF  :P:                    DEFINE :P: AS EXTERN
       $ENDIF
       $IF  B.V<2                  SINGLE WORD
       LAC  :P:,0                  LOAD :P: FROM SUBR
       SACL :A:,0                  SAVE IN :A:
       $ELSE                       MORE THAN ONE WORD
       REF  MOVAB$
       CALL MOVAB$                 CALL MOVER
       DATA :P:                    FROM :P:
       DATA :A:                    TO :A:
       DATA :B.V:                  FOR :B.V: WORDS
       $ENDIF
       $ASG L.SV+1 TO L.SV         NEXT ARG
       $END
GOSB6 $MACRO  B1,B2,B3,B4,B5,B6,B7,B8
       $IF    B1.L#=0
       $GOSB3 :B1:
       $ENDIF
       $IF    B2.L#=0
       $GOSB3 :B2:
       $ENDIF
       $IF    B3.L#=0
       $GOSB3 :B3:
       $ENDIF
       $IF    B4.L#=0
       $GOSB3 :B4:
       $ENDIF
       $IF    B5.L#=0
       $GOSB3 :B5:
       $ENDIF
       $IF    B6.L#=0
       $GOSB3 :B6:
       $ENDIF
       $IF    B7.L#=0
       $GOSB3 :B7:
       $ENDIF
       $IF    B8.L#=0
       $GOSB6 :B8:
       $ENDIF
       $END   GOSB6
GOSB7 $MACRO  B1,B2,B3,B4,B5,B6,B7,B8
       $IF    B1.L#=0
       $GOSB5 :B1:
       $ENDIF
       $IF    B2.L#=0
       $GOSB5 :B2:
       $ENDIF
       $IF    B3.L#=0
       $GOSB5 :B3:
       $ENDIF
       $IF    B4.L#=0
       $GOSB5 :B4:
       $ENDIF
       $IF    B5.L#=0
       $GOSB5 :B5:
       $ENDIF
       $IF    B6.L#=0
       $GOSB5 :B6:
       $ENDIF
       $IF    B7.L#=0
       $GOSB5 :B7:
       $ENDIF
       $IF    B8.L#=0
       $GOSB7 :B8:
       $ENDIF
       $END   GOSB7
*GOSUB MACRO (CALL PROC OR FUNC)
*AFFECTS: STACK, AC, POSSIBLY AR1 AND/OR AR0
*
*      GOSUB ROUTINE,(TO-LIST),(FROM-LIST)
*
*      ROUTINE   := NAME OF FUNC OR PROC BEING CALLED
*      T0-LIST   := TO-ARG!TO-ARG,TO-LIST
*      FROM-LIST := FROM-ARG!FROM-ARG,FROM-LIST
*
*      TO-ARG    := VARIABLE!(VARIABLE,LENGTH)!
*                   CONST!(CONST)!((CONST,CONST,...,CONST))
*      FROM-ARG  := VARIABLE!(VARIABLE,LENGTH)
*
*      TO-LIST   := A GROUP OF VARIABLES COPIED TO ROUTINE
*                   FORMAL LOCATIONS BEFORE CALL
*      FROM-LIST := A GROUP OF VARIABLES COPIED FROM FORMAL
*                   LOCATION AFTER THE RETURN
*      LENGTH    := NUMBER OF WORDS (IF OMITTED, DEFUALT IS ONE)
*      CONST     := CONSTANTS
GOSUB  $MACRO A,B,C
       $CHECK :A:
       $VAR L
       $ASG '$$CNTR' TO L.S
       $ASG 0 TO L.SV    INIT ARG COUNT
       $ASG :A: TO L.SS SAVE CALL NAME
       $IF  B.L#=0
       $GOSB6 :B:
       $ENDIF
       $IF  A.SA&$UNDF
       REF  :A:          DEFINE AS EXTERN
       $ENDIF
       CALL :A:          CALL SUBR
       $ASG 0 TO L.SV    INIT ARG COUNT
       $IF  C.L#=0
       $GOSB7 :C:
       $ENDIF
       $END
*GOTO - another way to say B
GOTO    $MACRO  A
        B       :A:
        $END
*IF-THEN-ELSE-ENDIF CONSTRUCTIONS
*USES: AC, AND RESOURCES NEED BY LET
*
*      IF   <COND>
*      [COMPUTE EXPRESSION IN AC|
*      THEN
*      [IF AC TEST FAILS TO BRANCH DO THIS|
*   [  ELSE
*      [IF AC TEST BRANCHES DO THIS|   | <---OPTIONAL
*      ENDIF
*OR:
*      IF   <COND>,<LET EXPRESSION>
*      THEN
*      [IF LET EXPRESSION TEST FAILS TO BRANCH DO THIS|
*  [   ELSE
*      [IF LET EXPRESSION BRANCHES DO THIS|  <---OPTIONAL
*      ENDIF
*
*IF'S MAY BE NESTED
*<COND> IS:
*           EQ     AC(EXPR) IS =0
*           NE     AC(EXPR) IS NOT =0
*           LT     AC(EXPR) IS <0
*           GT     AC(EXPR) IS >0
*           GE     AC(EXPR) IS NOT <0
*           LE     AC(EXPR) IS NOT >0
*      OR:
*           ANY 320 BRANCH INSTRUCTION

IF     $MACRO      C,EE
       $VAR I,E,Q,W,T
       $ASG '$$IFS' TO I.S      GET IS STACK INDEX
       $ASG I.SV+1 TO I.SV      PUSH
       $ASG '$$IF' TO Q.S
       $ASG :Q::I.SV: TO I.SS   MAKE CNTEXT VAR NAME
       $ASG '$$LAB' TO E.S      GET LABEL GEN
       $ASG E.SV+1 TO E.SV      NEXT LABEL
       $ASG :I.SS: TO W.S       MAKE THE CNTEXT NAME SYMBOL
       $ASG E.SV TO W.SV        SAVE LABEL INDEX AS VALUE
       $ASG 'EQ' TO T.S
       $IF  C.SV=T.SV           EQUAL
       $ASG 'BNZ' TO W.SS
       $ELSE
       $ASG 'NE' TO T.S
       $IF  C.SV=T.SV           NOT EQUAL
       $ASG 'BZ' TO W.SS
       $ELSE
       $ASG 'GT' TO T.S
       $IF  C.SV=T.SV           GT
       $ASG 'BLEZ' TO W.SS
       $ELSE
       $ASG 'LT' TO T.S
       $IF  C.SV=T.SV           LT
       $ASG 'BGEZ' TO W.SS
       $ELSE
       $ASG 'GE' TO T.S
       $IF  C.SV=T.SV           GE
       $ASG 'BLZ' TO W.SS
       $ELSE
       $ASG 'LE' TO T.S
       $IF  C.SV=T.SV           LE
       $ASG 'BGZ' TO W.SS
       $ELSE
       $ASG :C: TO W.SS         SAVE THE BRANCH
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $IF  EE.L#=0
       LET  :EE:                PROCSS LET EXPR
       $ENDIF
       $END
*INIT MEMORY MACRO
*USES: AR0, AR1, AC
*
*      INIT <ITEM-LIST>
*      <ITEM-LIST>:=<ITEM>!<ITEM>,<ITEM-LIST>
*      <ITEM>:=(<CONST>,VAR)
*      VAR IS A SYMBOLIC MEMORY LOCATION TO INITIALIZED
*      <CONST>:=VALUE!(VALUE,VALUE,VALUE, ... ,VALUE)
*      VALUE IS AN ASSY TIME CONSTANT

INIT   $MACRO            A1,A2,A3,A4,A5,A6,A7,A8
       CALL INIT$        CALL INIT SUBR
       REF  INIT$
       $IF  A1.L#=0
       $INIT3            :A1:   ITEM 1
       $ENDIF
       $IF  A2.L#=0
       $INIT3            :A2:   ITEM 2
       $ENDIF
       $IF  A3.L#=0
       $INIT3            :A3:   ITEM 3
       $ENDIF
       $IF  A4.L#=0
       $INIT3            :A4:   ITEM 4
       $ENDIF
       $IF  A5.L#=0
       $INIT3            :A5:   ITEM 5
       $ENDIF
       $IF  A6.L#=0
       $INIT3            :A6:   ITEM 6
       $ENDIF
       $IF  A7.L#=0
       $INIT3            :A7:   ITEM 7
       $ENDIF
       $IF  A8.L#=0
       $INIT2            :A8:   ITEM 8
       $ENDIF
       DATA -1           END OF INIT LIST
       $END
INIT2 $MACRO            A,B
       $INIT3            :A:  DO AN ITEM
       $IF  B.L#=0
       $INIT2            :B:  RECURS
       $ENDIF
       $END
INIT3 $MACRO            A,B
       $IF  A.L#=0
       $IF  A.A&$POPL    VALUE LIST
       DATA :A.V:        FOR :A.V: WORDS
       $ELSE
       DATA 1            FOR ONE WORD
       $ENDIF
       DATA :B:          TO :B:
       DATA :A:          DATA LIST
       $ENDIF
       $END
*TEST IF VALUE IS IN A RANGE
*USES: AC
*
*      INRNG   VAR,LOW,HIGH,LABEL
*
*BRANCH TO LABEL IF THE CONTENTS OF VAR IS >=LOW
*      <= HIGH
*LOW AND HIGH MAY BE CONSTANTS OR VARIABLES

       COPY  MACROS.LCAC

INRNG  $MACRO            A,B,C,D   RANGE INSIDE TEST
       $VAR L
       $ASG '$$LAB' TO L.S    UNIQUE LABEL VAR
       $ASG L.SV+1 TO L.SV
       $IF  B.SA&$UNDF
       LCAC -(:B.V:)     LOAD -(:B:)
       ADD  :A:,0        COMP TO :A:
       $ELSE
       LAC  :A:,0        LOAD :A:
       SUB  :B:,0        COMP TO :B:
       $ENDIF
       BLZ  L$:L.SV:     BRANCH IF :A:<:B:
       $IF  C.SA&$UNDF
       LCAC -(:C.V:)     LOAD -(:C:)
       ADD  :A:,0        COMP TO :A:
       $ASG L.SV-1 TO L.SV
       $ELSE
       LAC  :A:,0        LOAD :A:
       SUB  :C:,0        COMP TO :C:
       $ENDIF
       BLEZ :D:          BRANCH IF :A:>=:B: & :A:<=:C:
L$:L.SV: EQU $
       $END
*INTERRUPT PROCEDURE DEFINITION MACRO
*      SETS UP VECTOR AT 0 AND 2, DISABLE
*      INTERRUPTS, SAVES AC, AR1, AR0, STATUS, PC
*
*A IS INTR NAME (<4 CHAR), B IF MAIN NAME (<4 CHAR)
*
INTR   $MACRO            A,B
       CHECK :A:
       PSEG              PROG SEG
       B    :B:          BRANCH TO MAIN
       DEF  :A:
:A:    EQU  $            INTRPT ENTRY
       DINT              DISBLE
       SST  :A:$S        SAVE STATUS
       LDPK 1            TO 2ND PAGE
       SACX :A:$C        SAVE AC (DOUBLE)
       POP               POP RETURN
       SACL :A:$R,0      SAVE AS RETURN
       SAR  AR0,:A:$0    SAVE AR0
       SAR  AR1,:A:$1    SAVE AR1
       LDPK 0            BACK TO PAGE 1
       $VAR Q
       $ASG '''' TO Q.S
       CSEG :Q::A:$C:Q:  INTRPT COMMON
:A:$S  BSS  1            STATUS SAVE
:A:$C  BSS  2            AC SAVE
:A:$R  BSS  1            RETURN SAVE
:A:$0  BSS  1            AR0 SAVE
:A:$1  BSS  1            AR1 SAVE
       CEND              END
       $VAR P
       $ASG '$$PROC' TO P.S
       $ASG 3 TO P.SV    FLAG INTRPT
       $ASG :A: TO P.SS
       $ASG '$$IPRC' TO P.S
       $ASG :A: TO P.SS
       $END
*DEFINE IVAR VARS (AFTER INTR MACRO ONLY)
*
*      IVAR VAR-LIST
*
*      VAR-LIST:=VAR-ITEM!VAR-ITEM,VAR-LIST
*      VAR-ITEM:=VAR!(VAR,SIZE)
*      VAR IS VARIABLE SYMBOL
*      SIZE IS NUMBER OF WORDS TO ALLOCATE

IVAR   $MACRO  A1,A2,A3,A4,A5,A6,A7,A8
       $VAR Q,P
       $ASG '$$IPRC' TO P.S
       $ASG '''' TO Q.S
       CSEG :Q::P.SS:$C:Q: PAGE 1 INTR SEG
       $IF     A1.L#=0
       $IVR3   :A1:
       $ENDIF
       $IF     A2.L#=0
       $IVR3   :A2:
       $ENDIF
       $IF     A3.L#=0
       $IVR3   :A3:
       $ENDIF
       $IF     A4.L#=0
       $IVR3   :A4:
       $ENDIF
       $IF     A5.L#=0
       $IVR3   :A5:
       $ENDIF
       $IF     A6.L#=0
       $IVR3   :A6:
       $ENDIF
       $IF     A7.L#=0
       $IVR3   :A7:
       $ENDIF
       CEND              END OF DATA
       $IF     A8.L#=0
       IVAR    :A8:
       $ENDIF
       $END
IVR3  $MACRO   A,B
       $IF  B.L#=0
:A:    BSS  :B:          :B: WORDS NAME :A:
       $ELSE
:A:    BSS  1            1 WORD NAMED :A:
       $ENDIF
       $END
*LET MACRO -- INTEGER COMPUTATIONS
*      LET  LET-EXPR
*      LET-EXPR:=A!A,OP,B
*      A:=(LET-EXPR)!CONSTANT!SYMBOLIC RAM LOC LABEL!EMPTY
*           IF AA IS EMPTY, MEANS VALUE IN THE AC
*           (CONTINUATION FROM PREVIOUS LET)
*      B:=(LET-EXPR)!CONSTANT!SYMBOLIC RAM LOC LABEL
*      OP:=+!-!/!*!&!##!--!//!LT!GT!EQ!LE!GE!NE!^
*           ADD -> +     LESS THAN ------------> LT
*           SUB -> -     GREATER THAN ---------> GT
*           DIV -> /     EQUAL ----------------> EQ
*           MPY -> *     LESS THAN OR EQUAL ---> LE
*           AND -> &     GREATER THAN OR EQUAL-> GE
*           XOR -> ##    NOT EQUAL ------------> NE
*           OR  -> ++
*           MOD -> //    SHIFT -> ^
*
LET    $MACRO  A,OP,B
       $VAR T,S,SF,ST,DB,NS,SZ
       $ASG '$$STSZ' TO SZ.S
       $ASG '$$STAR' TO NS.S
       $ASG '^' TO SF.S
       $IF  A.L#=0
       $IF  A.A&$POPL
       LET  :A:
       $ELSE
       $IF A.SA&$UNDF
       $IF  OP.SV=SF.SV
       LCAC :A:,:B:
       $ELSE
       LCAC :A:
       $ENDIF
       $ELSE
       $IF  OP.SV=SF.SV
       LAC  :A:,:B:
       $ELSE
       LAC  :A:,0
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $IF  (OP.L#=0)&(OP.SV#=SF.SV)
       $ASG '$$STSL' TO ST.S
       $ASG 1 TO S.V
       $ASG 0 TO DB.V
       $ASG '+' TO T.S
       $IF  OP.SV=T.SV
       $ASG 1 TO DB.V
       $ENDIF
       $ASG '-' TO T.S
       $IF  OP.SV=T.SV
       $ASG 1 TO DB.V
       $ENDIF
       $ASG '/' TO T.S
       $IF  OP.SV=T.SV
       $ASG 1 TO DB.V
       $ENDIF
       $ASG '//' TO T.S
       $IF  OP.SV=T.SV
       $ASG 1 TO DB.V
       $ENDIF
       $IF  B.A&$POPL
       $IF  ST.SV=0
       $IF  NS.SV<0
       LARK AR1,LETST$   LOAD STACK POINTR
       LARP AR1
       $ENDIF
       $ENDIF
       $ASG ST.SV+1 TO ST.SV
       MAR  *+
       $IF  DB.V
       SACH *+,0
       $ASG ST.SV+1 TO ST.SV
       $ENDIF
       SACL *,0
       $IF  SZ.SV<ST.SV
 ERROR ***LETSET stack size of :ST.SV: is req'd***
       $ENDIF
       LET  :B:
       $ASG ST.SV-1 TO ST.SV
       $IF  DB.V
       $ASG ST.SV-1 TO ST.SV
***** THIS ENDIF CHANGED FROM $ELSE....
       $ENDIF
       $IF  B.SA&$UNDF
       $IF  ST.SV=0
       $IF  NS.SV<0
       LARK AR1,LETST$   LOAD STACK POINTR
       LARP AR1
       $ENDIF
       $ENDIF
       MAR  *+
       $IF  DB.V
       SACH *+,0
       SACL *,0
       $IF  SZ.SV<2
 ERROR ***LETSET stack size of 2 is req'd***
       $ENDIF
       $ELSE
       SACL *,0
       $IF  SZ.SV<1
 ERROR ***LETSET stack size of 1 is req'd***
       $ENDIF
       $ENDIF
       LCAC :B:
       $ELSE
       $ASG 0 TO S.V         LITRAL SECOND OPERND
       $ASG '+' TO T.S
       $IF  OP.SV=T.SV
       ADD  :B:,0             +
       $ENDIF
       $ASG '-' TO T.S
       $IF  OP.SV=T.SV
       SUB  :B:,0             -
       $ENDIF
       $ASG '*' TO T.S
       $IF  OP.SV=T.SV
       SACL XR0,0             SAVE AC
       LT   XR0               LOAD T
       MPY  :B:               *
       PAC                    TO AC
       $ENDIF
       $ASG '/' TO T.S
       $IF  OP.SV=T.SV
       SACH DDV$0+0,0         SAVE AC HIGH
       SACL DDV$0+1,0         SAVE AC LOW
       LAC  :B:,0             LOAD :B:
       SACL DDV$1,0           SAVE :B:
       CALL DDV$              DIVIDE
       $IF  NS.SV=0
       LARP AR0
       $ENDIF
       LAC  DDV$2,0           LOAD QUOT
       REF  DDV$,DDV$0,DDV$1,DDV$2,DDV$3
       $ENDIF
       $ASG '//' TO T.S
       $IF  OP.SV=T.SV
       SACH DDV$0+0,0         SAVE AC HIGH
       SACL DDV$0+1,0         SAVE AC LOW
       LAC  :B:,0             LOAD :B:
       SACL DDV$1,0           SAVE :B:
       CALL DDV$              DIVIDE
       $IF  NS.SV=0
       LARP AR0
       $ENDIF
       LAC  DDV$3,0           LOAD REM
       REF  DDV$,DDV$0,DDV$1,DDV$2,DDV$3
       $ENDIF
       $ASG '&' TO T.S
       $IF  OP.SV=T.SV
       AND  :B:               AND
       $ENDIF
       $ASG '##' TO T.S
       $IF  OP.SV=T.SV
       XOR  :B:               XOR
       $ENDIF
       $ASG '++' TO T.S
       $IF  OP.SV=T.SV
       OR   :B:               OR
       $ENDIF
       $ENDIF
       $ENDIF
       $IF S.V               STACKD 1ST OPERND
       $ASG '+' TO T.S
       $IF  OP.SV=T.SV
       ADDS *-
       ADDH *-                +
       $ENDIF
       $ASG '-' TO T.S
       $IF  OP.SV=T.SV
       SACL XR0,0             SAVE SECOND
       SACH XR1,0
       ZALS *-                RELOAD FIRST
       ADDH *-
       SUBS XR0               1ST-2ND
       SUBH XR1
       $ENDIF
       $ASG '/' TO T.S
       $IF  OP.SV=T.SV
       SACL DDV$1,0           SAVE 2ND
       LAC  *-,0              LOAD
       SACL DDV$0+1,0         SAVE LOW
       LAC  *-,0              LOAD
       SACL DDV$0+0,0         SAVE HIGH
       CALL DDV$              DIVIDE
       $IF  NS.SV=0
       LARP AR0
       $ENDIF
       LAC  DDV$2,0           LOAD QUOT
       REF  DDV$,DDV$0,DDV$1,DDV$2,DDV$3
       $ENDIF
       $ASG '//' TO T.S
       $IF  OP.SV=T.SV
       SACL DDV$1,0           SAVE 2ND
       LAC  *-,0              LOAD
       SACL DDV$0+1,0         SAVE LOW
       LAC  *-,0              LOAD
       SACH DDV$0+0,0         SAVE HIGH
       CALL DDV$              DIVIDE
       $IF  NS.SV=0
       LARP AR0
       $ENDIF
       LAC  DDV$3,0           LOAD REM
       REF  DDV$,DDV$0,DDV$1,DDV$2,DDV$3
       $ENDIF
       $ASG '*' TO T.S
       $IF  OP.SV=T.SV
       SACL XR0,0             GET 2ND
       LT   XR0               TO T REG
       MPY  *-                MPY BY STACK
       PAC                    TO AC
       $ENDIF
       $ASG '&' TO T.S
       $IF  OP.SV=T.SV
       AND  *-                AND
       $ENDIF
       $ASG '##' TO T.S
       $IF  OP.SV=T.SV
       XOR  *-                XOR
       $ENDIF
       $ASG '++' TO T.S
       $IF  OP.SV=T.SV
       OR   *-                OR
       $ENDIF
       $ENDIF
       $ENDIF
       $END
*LETSET SETS UP LET STACK AND INITS LET OPERATOR SYMBOLS
*      LETSET <SIZE (WORDS) OF STACK>,<STACK AR REGISTER>
*      IF SECOND OPERAND IS SPECIFIED, THE AR IS LOADED WITH
*      THE TOP OF THE STACK, AND THE ARP IS SET (SECOND OPERAND
*      IS OPTIONAL, IN WHICH CASE, THE STACK IS SET UP IN THE
*      LET MACRO IF NEEDED).
*
LETSET $MACRO  Z,AR
       $VAR T,L
       $ASG '$$STSZ' TO T.S
       $ASG 0 TO T.SV
       $IF  Z.V#=0
       CSEG 'LETST$'
LETST$ EQU  $
       BSS  :Z:          STACK AREA
       $ASG $-LETST$ TO T.SV
       CEND
       $ENDIF
       $ASG '^' TO T.S
       $ASG >F0EF TO T.SV
       $ASG '+' TO T.S
       $ASG >F0F3 TO T.SV
       $ASG '-' TO T.S
       $ASG >F0F4 TO T.SV
       $ASG '/' TO T.S
       $ASG >F0F5 TO T.SV
       $ASG '//' TO T.S
       $ASG >F0F6 TO T.SV
       $ASG '&' TO T.S
       $ASG >F0F7 TO T.SV
       $ASG '##' TO T.S
       $ASG >F0F8 TO T.SV
       $ASG '++' TO T.S
       $ASG >F0F9 TO T.SV
       $ASG 'LT' TO T.S
       $ASG >F0FA TO T.SV
       $ASG 'LE' TO T.S
       $ASG >F0FB TO T.SV
       $ASG 'GT' TO T.S
       $ASG >F0FC TO T.SV
       $ASG 'GE' TO T.S
       $ASG >F0FD TO T.SV
       $ASG 'EQ' TO T.S
       $ASG >F0FE TO T.SV
       $ASG 'NE' TO T.S
       $ASG >F0FF TO T.SV
       $ASG '$$STSL' TO T.S
       $ASG 0 TO T.SV
       $ASG '$$LSOP' TO T.S
       $ASG 0 TO T.SV
       $ASG '$$STAR' TO T.S
       $ASG -1 TO T.SV
       $IF  AR.L#=0
       LARK :AR:,LETST$       LOAD STACK POINTR
       LARP :AR:              SET ARP
       $ASG AR.SV TO T.SV
       $ENDIF
       $END
*MOVE L(CONST) WORDS FROM A(ROM ITEM) TO B(RAM VAR)
*ROM ITEM IS:
*      SYMBOL (VAR IN ROM)
*      CONSTANT
*      CONSTANT LIST-> (CONSTANT, CONSTANT, ... , CONSTANT)
*
MVC   $MACRO A,B,L
       $VAR ST,SP,SM
       $ASG '*' TO ST.S
       $ASG '*+' TO SP.S
       $ASG '*-' TO SM.S
       $IF  L.V<2
       $IF  A.L#=0
       LCAC :A:
       $ENDIF
       $IF  A.SV=ST.SV
       ARTAC AR0
       $ENDIF
       TBLR :B:          READ ONE WORD
       $ENDIF
       $IF  L.V=2
       $IF  B.SV=ST.SV
       $IF  A.SV=ST.SV
       ARTAC AR0
       $ELSE
       $IF  A.L#=0
       LCAC :A:
       $ENDIF
       $ENDIF
       TBLR *+           READ FIRST WORD
       ADD  ONE,0        INCR PNTER
       TBLR *-           READ NEXT WORD
       $ELSE
       $IF  B.SV=SP.SV
       $IF  A.SV=ST.SV
       ARTAC AR0
       $ELSE
       $IF  A.L#=0
       LCAC :A:
       $ENDIF
       $ENDIF
       TBLR *+           READ FIRST WORD
       ADD  ONE,0        INCR PNTER
       TBLR *+           READ NEXT WORD
       $ELSE
       $IF  B.SV=SM.SV
       $IF  A.SV=ST.SV
       ARTAC AR0
       ADD  ONE,0        INCR PNTER
       $ELSE
       $IF  A.L#=0
       LCAC :A:+1
       $ELSE
       ADD  ONE,0        INCR PNTER
       $ENDIF
       $ENDIF
       TBLR *-           READ LAST WORDS
       SUB  ONE,0        DECR PNTER
       TBLR *-           READ FIRST WORD
       $ELSE
       $IF  A.SV=ST.SV
       ARTAC AR0
       $ELSE
       $IF  A.L#=0
       LCAC :A:
       $ENDIF
       $ENDIF
       TBLR :B:          READ FIRST WORD
       ADD  ONE,0        INCR PNTER
       TBLR :B:+1        READ SECND WORD
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $IF  L.V>2
       $IF  B.SV=ST.SV
       $IF  A.L#=0
       CALL MOVC$A       MOVE
       REF  MOVC$A
       DATA :A:            FROM :A:
       $ELSE
       CALL MOVC$$       MOVE
       REF  MOVC$$
       $ENDIF
       $ELSE
       $IF  A.L#=0
       CALL MOVA$B       MOVE
       REF  MOVA$B
       DATA :A:            FROM :A:
       $ELSE
       CALL MOVC$B       MOVE
       REF  MOVC$B
       $ENDIF
       DATA :B:            TO :B:
       $ENDIF
       DATA :L:            FOR :L: WORDS
       $ENDIF
       $END
       $END
*END OF FOR, WHILE, OR UNTIL LOOP
*
NEXT   $MACRO
       $VAR I,W,T,Q
       $ASG '$$LPS' TO I.S           GET CNTXT VAR
       $ASG '$$LP' TO Q.S
       $ASG :I.SS: TO W.S            MAKE THIS CNTXT VAR
       B    I$:W.SV:                 BR TO LOOP START
E$:W.SV: EQU $                       END OF LOOP
       $ASG I.SV-1 TO I.SV           POP CNTXT
       $ASG :Q::I.SV: TO I.SS        MAKE OLD THIS CNTXT VAR
       $END
*
* TEST FOR OUT OF RANGE
*
*      OUTRNG VAR,LOW,HIGH,LABEL
*
*BRANCH TO LABEL IF CONT OF VAR > HIGH OR < LOW
*LOW AND HIGH ARE VARS OR CONSTANTS

       COPY MACROS.LCAC

OUTRNG $MACRO            A,B,C,D   RANGE OUTSIDE TEST
       $IF  B.SA&$UNDF
       LCAC -(:B.V:)     LOAD CONST -:B:
       ADD  :A:,0        COMP :A:
       $ELSE
       LAC  :A:,0        LOAD :A:
       SUB  :B:,0        COMP TO :B:
       $ENDIF
       BLZ  :D:          BR IF :A:<:B:
       $IF  C.SA&$UNDF
       LCAC -(:C.V:)     LOAD CONST -:C:
       ADD  :A:,0        COMP TO :A:
       $ELSE
       LAC  :A:,0        LOAD :A:
       SUB  :C:,0        COMP TO :C:
       $ENDIF
       BGZ  :D:          BR IF :A:>:C:
       $END
*EVAL POLYNOMIAL
*X IS VAR CONTAINING A VALUE
*T IS AN EMPTY ARRAY THAT GETS SET TO
*      1 X X**2 X**3 ... X**N
*A IS THE COEFFICIENT ARRAY
*L IS THE POLY ORDER

       COPY MACROS.POWERS
       COPY MACROS.DOTP

POLY   $MACRO            X,T,A,L
       POWERS            :X:,:T:,:L:
       DOTP              :T:,:A:,:L:+1
       $END
POW2  $MACRO            X,T,L
       $VAR TT
       MPY  :X:          MULT BY VAR
       PAC               TO AC
       SACL :T:,0        STORE IN ARRAY
       $IF  L.V>0        RECUR
       $ASG L.V-1 TO TT.V
       $POW2             :X:,:T:+1,:TT.V:
       $ENDIF
       $END
*COMPUTE POWERS OF X
*X IS VARIABLE CONTAINING A NUMBER
*T IS SET TO: 1 X X**2 X**3, ... , X**L

POWERS $MACRO            X,T,L
       $VAR TT
       LACK 1            LOAD A ONE
       SACL :T:,0        INTO FIRST LOC
       $IF  L.V>0
       LAC  :X:,0        LOAD THE VAR
       SACL :T:+1,0      INTO SECOND LOC
       $ENDIF
       $IF  L.V>1
       LT   :X:          LOAD THE VAR INTO T
       MPY  :X:          SQUARE IT
       PAC               TO THE AC
       SACL :T:+2,0      TO THE THIRD LOC
       $ENDIF
       $IF  L.V>2        RECUR
       $ASG L.V-3 TO TT.V
       $POW2             :X:,:T:+3,:TT.V:
       $ENDIF
       $END
*PROCEDURE DEFINITION MACRO
*      GENERATES FORMAL ARGUMENT LOCATIONS, SAVES AR1&0, AND POPS
*      RETURN STACK
*
*      PROC NAME,FORMAL-LIST
*      FORMAL-LIST:=NIL!FORMAL!FORMAL,FORMAL-LIST
*      FORMAL:=VAR!(VAR,SIZE)
*
*      VAR IS VARIABLE NAME USED IN FUNCTION
*      SIZE IS THE NUMBER OF WORDS REQUIRED
*      NAME IF THE PROCEDURE NAME (<4 CHARS)

       COPY CHECK.SCR
       COPY CREF.SCR
       COPY PROC2.SCR

PROC   $MACRO            A,B1,B2,B3,B4,B5,B6,B7,B8
       $CHECK :A:
       PSEG              PROG SEG
       DEF  :A:          DEF ENTRY
:A:    EQU  $            ENTRY
       POP               POP RETURN
       SACL :A:$R,0      SAVE IN :A:$R
       SAR  AR0,:A:$0    SAVE AR0
       SAR  AR1,:A:$1    SAVE AR1
       DSEG              DATA SEG
:A:$R  BSS  1            RETURN SAVE
:A:$0  BSS  1            AR0 SAVE
:A:$1  BSS  1            AR1 SAVE
       $VAR L
       $ASG '$$CNTR' TO L.S
       $ASG 0 TO L.SV    INIT FORMAL COUNT
       $ASG :A: TO L.SS
       $IF    B1.L#=0
       $PROC3 :B1:
       $ENDIF
       $IF    B2.L#=0
       $PROC3 :B2:
       $ENDIF
       $IF    B3.L#=0
       $PROC3 :B3:
       $ENDIF
       $IF    B4.L#=0
       $PROC3 :B4:
       $ENDIF
       $IF    B5.L#=0
       $PROC3 :B5:
       $ENDIF
       $IF    B5.L#=0
       $PROC3 :B6:
       $ENDIF
       $IF    B7.L#=0
       $PROC3 :B7:
       $ENDIF
       $IF    B8.L#=0
       $PROC2 :B8:
       $ENDIF
       DEND              END OF DATA
       $VAR P
       $ASG '$$PROC' TO P.S
       $ASG 1 TO P.SV    FLAG PROC TYPE
       $ASG :A: TO P.SS
       $END
*MACROS INTERNAL TO MAIN, PROC, FUNC, INTR
*
PROC2 $MACRO            A,B
       $PROC3            :A:
       $IF  B.L#=0       IF MORE RECURS
       $PROC2            :B:
       $ENDIF
       $END
PROC3 $MACRO            A,B
       $IF  A.L#=0
:A:    EQU  $            INTL NAME DEF
       $VAR L
       $ASG '$$CNTR' TO L.S
:L.SS::L.SV: EQU $       EXTL NAME DEF
       DEF  :L.SS::L.SV:
       $IF  B.L#=0
       BSS  :B:          :B: WORDS
       $ELSE
       BSS  1            1 WORD
       $ENDIF
       $ENDIF
       $ASG L.SV+1 TO L.SV NEXT ARG
       $END
RSOP  $MACRO            A,B
       $SOP :A:
       $IF  B.L#=0
       $RSOP             :B:
       $ENDIF
       $END
*SELECT CASE TO RUN BY MATCHING VALUES
*
*      SELECT A,(V0,V1,V2,...,VN-1),(L0,L1,L2,...,LN)
*      [RETURNS HERE|
*         .
*         .
*         .
*L0    [DO THIS WHEN A=V0|
*      RET
*L1    [DO THIS WHEN A=V1|    V0-VN ARE CONSTANTS
*      RET
*L2    [DO THIS WHEN A=V2|    A IS A USER VARIABLE
*      RET
*         .                   L0-LN ARE LABELS
*         .
*         .
*LN-1  [DO THIS WHEN A=VN-1|
*      RET
*LN    [DO THIS WHEN A NOT ANY VN|
*      RET

SELECT $MACRO    A,C,D,B
       $IF  B.L=0             GET TEMP
       $ASG 'XR0' TO B.S
       $ENDIF
       LAC  :A:,0             LOAD SELECT :A:
       CALL SEL$              CALL MATCHR
       REF  SEL$
       DATA :C.V:             NUMBER OF ITEMS
       DATA :C:               ITEM LIST
       SACL :B:,0             SAVE INDEX IN TEMP
       $VAR L
       $ASG '$$LAB' TO L.S
       $ASG L.SV+1 TO L.SV    GET A LABEL
       CALL L$:L.SV:          CALL OVER COMPTD GOTO LIST
       DATA :D:               LABEL LIST
L$:L.SV: POP                  POP LABEL LIST ADDR
       ADD  :B:,0             ADD INDEX
       TBLR :B:               READ LABEL
       LAC  :B:,0             TO AC
       CALA                   GOT TO IT
       $END
SOP   $MACRO            AA,B,C
       $VAR T,A,F
       $ASG '$$FSOP' TO F.S
       $ASG '##' TO T.S
       $IF  (AA.SV#=T.SV)&(F.SV=0)
       $ASG '$$LSOP' TO A.S
       $IF  A.SV=0
       $IF  C.SA&$UNDF
       CALL LTK$         LOAD
       REF  LTK$
       DATA :C:             :C:
       $ELSE
       LT   :C:          LOAD :C:
       $ENDIF
       $ELSE
       $IF  C.L#=0
       $ASG '+' TO T.S
       $IF  T.SV=A.SV
       $IF  C.SA&$UNDF
       APAC              ADD P TO AC
       CALL LTK$         LOAD
       REF  LTK$
       DATA :C:             :C:
       $ELSE
       LTA  :C:          LOAD :C: AND ADD P TO AC
       $ENDIF
       $ENDIF
       $ASG '++' TO T.S
       $IF  T.SV=A.SV
       $IF  C.SA&$UNDF
       APAC              ADD P TO AC
       CALL LTK$         LOAD
       REF  LTK$
       DATA :C:             :C:
       $ELSE
       LTD  :C:          LOAD :C:, ADD P TO AC, :C:->:C:+1
       $ENDIF
       $ENDIF
       $ASG '-' TO T.S
       $IF  T.SV=A.SV
       $IF  C.SA&$UNDF
       SPAC              SUB P FROM AC
       CALL LTK$         LOAD
       REF  LTK$
       DATA :C:            :C:
       $ELSE
       SPAC              SUB P FROM AC
       LT   :C:          LOAD :C:
       $ENDIF
       $ENDIF
       $ELSE
       $ASG '+' TO T.S
       $IF T.SV=A.SV
       APAC              ADD P TO AC
       $ENDIF
       $ASG '++' TO T.S
       $IF  T.SV=A.SV
       APAC              ADD P TO AC
       $ENDIF
       $ASG '-' TO T.S
       $IF  T.SV=A.SV
       SPAC              SUB P FROM AC
       $ENDIF
       $ENDIF
       $ENDIF
       $IF  B.L#=0
       $IF  B.SA&$UNDF
       MPYK :B:          MLTPLY CONST :B:
       $ELSE
       MPY  :B:          MLTPLY :B:
       $ENDIF
       $ENDIF
       $ASG AA.SV TO A.SV
       $ELSE
       $ASG 1 TO F.SV
       $ENDIF
       $END
*STOP MACRO
*      RETURNS FROM INTR, PROC OR FUNC
*
STOP   $MACRO
       $VAR P
       $ASG '$$PROC' TO P.S
       $IF  P.SV=0
       RET               RETURN FROM A FUNC
       $ENDIF
       $IF  P.SV=1
       LAR  AR0,:P.SS:$0 REST AR0
       LAR  AR1,:P.SS:$1 REST AR1
       LAC  :P.SS:$R,0   REST RETURN
       PUSH              TO STACK
       RET               RETURN FROM PROC
       $ENDIF
       $IF  P.SV=2
       B    :P.SS:       SIM A RESET (FROM MAIN)
       $ENDIF
       $IF P.SV=3
       LDPK 1            GET TO INTR PAGE
       LAR  AR0,:P.SS:$0 REST AR0
       LAR  AR1,:P.SS:$1 REST AR1
       LAC  :P.SS:$R,0   LOAD RETURN
       PUSH              PUSH TO STACK
       LDAX :P.SS:$C     RELOAD AC
       LST  :P.SS:$S     REST STATUS
       EINT              ENABLE INTRPS
       RET               RETURN FROM INTRPT
       $ENDIF
       $END
*SUMOFP - SUMS OF PRODUCTS
*
*      SUMOFP    PRODUCTS-LIST
*
*      PRODUCTS-LIST:=P-LIST,END-ITEM
*      P-LIST:=PRODUCT-ITEM,P-LIST!PRODUCT-ITEM
*      PRODUCT-ITEM:=(OPR,P1,P2,INCR)!##
*      P1:=MULTIPLIER
*      P2:=MULTIPLICAND (TO THE T REGISTER)
*          (IF P2 IS BLANK, USE THE LAST P2)
*      OPR:=+!-!++
*           + IS LOAD T AND ACCUMULATE
*           ++ IS LOAD T AND ACCUMULATE (WITH MOVE)
*           - IS LOAD T AND SUBTRACT FROM AC
*      ##:=CONTINUATION ITEM (NEXT STMT WILL CONTINUE)

SUMOFP $MACRO            A1,A2,A3,A4,A5,A6,A7,A8
       $VAR T,F
       $ASG '$$FSOP' TO F.S
       $ASG 0 TO F.SV
       $ASG '$$LSOP' TO T.S
       $IF  T.SV=0
       ZAC
       $ENDIF
       $IF  A1.L#=0
       $SOP :A1:
       $ENDIF
       $IF  A2.L#=0
       $SOP :A2:
       $ENDIF
       $IF  A3.L#=0
       $SOP :A3:
       $ENDIF
       $IF  A4.L#=0
       $SOP :A4:
       $ENDIF
       $IF  A5.L#=0
       $SOP :A5:
       $ENDIF
       $IF  A6.L#=0
       $SOP :A6:
       $ENDIF
       $IF  A7.L#=0
       $SOP :A7:
       $ENDIF
       $IF  A8.L#=0
       $RSOP :A8:
       $ENDIF
       $IF  F.SV=0
       $SOP +
       $ASG 0 TO T.SV
       $ENDIF
       $END
*
THEN   $MACRO
       $VAR I,W
       $ASG '$$IFS' TO I.S      GET CNTEXT VAR
       $ASG :I.SS: TO W.S       MAKE THIS CNTEXT VAR
       :W.SS: A$:W.SV:          BRANCH TO ELSE CLAUSE
       $END
*UNTIL LOOP MACRO
*USES: AC AND LET MACRO
*
*      UNTIL COND
*           [CONDITION COMP IN AC|
*      DO
*           [LOOP BODY-DONE IF AC TEST AT DO IS FALSE|
*      NEXT
*OR:
*      UNTIL COND,<LET EXPR>
*      DO
*           [LOOP BODY-DONE IF <LET EXPR> TEST IS FALSE|
*      NEXT
*
*CONDITIONS (COND) ARE THE SAME AS IN IF

       COPY MACROS.NEXT
       COPY MACROS.DO

UNTIL  $MACRO          C,EE   START UNTIL CONDITIONAL
       $VAR I,E,Q,W,T
       $ASG '$$LPS' TO I.S    GET CNTXT VAR
       $ASG I.SV+1 TO I.SV    PUSH CNTXT
       $ASG '$$LP' TO Q.S
       $ASG :Q::I.SV: TO I.SS MAKE THIS CNTXT NAME
       $ASG '$$LAB' TO E.S    GET UIQUE LABEL
       $ASG E.SV+1 TO E.SV    INCR
       $ASG :I.SS: TO W.S     MAKE THIS CNTXT
       $ASG E.SV TO W.SV      SAVE LABEL IN THIS CNTXT
       $ASG 'EQ' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BZ' TO W.SS
       $ELSE
       $ASG 'NE' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BNZ' TO W.SS
       $ELSE
       $ASG 'LT' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BLZ' TO W.SS
       $ELSE
       $ASG 'GT' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BGZ' TO W.SS
       $ELSE
       $ASG 'LE' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BLEZ' TO W.SS
       $ELSE
       $ASG 'GE' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BGEZ' TO W.SS
       $ELSE
       $ASG :C.S: TO W.SS
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
I$:W.SV: EQU $                TOP OF LOOP
       $IF  EE.L#=0
       LET  :EE:              DO LET
       $ENDIF
       $END
*DEFINE VAR VARS
*
*      VAR   VAR-LIST
*
*      VAR-LIST:=VAR-ITEM!VAR-ITEM,VAR-LIST
*      VAR-ITEM:=VAR!(VAR,SIZE)
*      VAR IS VARIABLE SYMBOL
*      SIZE IS NUMBER OF WORDS TO ALLOCATE

VAR    $MACRO  A1,A2,A3,A4,A5,A6,A7,A8
       DSEG              DATA SEG
       $IF     A1.L#=0
       $VAR3   :A1:
       $ENDIF
       $IF     A2.L#=0
       $VAR3   :A2:
       $ENDIF
       $IF     A3.L#=0
       $VAR3   :A3:
       $ENDIF
       $IF     A4.L#=0
       $VAR3   :A4:
       $ENDIF
       $IF     A5.L#=0
       $VAR3   :A5:
       $ENDIF
       $IF     A6.L#=0
       $VAR3   :A6:
       $ENDIF
       $IF     A7.L#=0
       $VAR3   :A7:
       $ENDIF
       DEND              DATA END
       $IF     A8.L#=0
       VAR     :A8:
       $ENDIF
       $END
VAR3  $MACRO   A,B
       $IF  B.L#=0
:A:    BSS  :B:          :B: WORDS NAME :A:
       $ELSE
:A:    BSS  1            1 WORD NAMED :A:
       $ENDIF
       $END
*WHILE LOOP MACRO
*USES: AC AND LET MACRO
*
*      WHILE COND
*           [CONDITION COMP IN AC|
*      DO
*           [LOOP BODY-DONE IF AC TEST IS TRUE|
*      NEXT
*OR:
*      WHILE COND,<LET EXPR>
*      DO
*           [LOOP BODY-DONE IF <LET EXPR> TEST IS TRUE|
*      NEXT

       COPY MACROS.NEXT
       COPY MACROS.DO

WHILE  $MACRO          C,EE   START WHILE CONDITIONAL
       $VAR I,E,Q,W,T
       $ASG '$$LPS' TO I.S    GET CNTXT VAR
       $ASG I.SV+1 TO I.SV    PUSH CNTXT
       $ASG '$$LP' TO Q.S
       $ASG :Q::I.SV: TO I.SS MAKE THIS CNTXT NAME
       $ASG '$$LAB' TO E.S    GET UIQUE LABEL
       $ASG E.SV+1 TO E.SV    INCR
       $ASG :I.SS: TO W.S     MAKE THIS CNTXT
       $ASG E.SV TO W.SV      SAVE LABEL IN THIS CNTXT
       $ASG 'EQ' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BNZ' TO W.SS
       $ELSE
       $ASG 'NE' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BZ' TO W.SS
       $ELSE
       $ASG 'LT' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BGEZ' TO W.SS
       $ELSE
       $ASG 'GT' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BLEZ' TO W.SS
       $ELSE
       $ASG 'LE' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BGZ' TO W.SS
       $ELSE
       $ASG 'GE' TO T.S
       $IF  C.SV=T.SV
       $ASG 'BLZ' TO W.SS
       $ELSE
       $ASG :C.S: TO W.SS
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
       $ENDIF
I$:W.SV: EQU $                TOP OF LOOP
       $IF  EE.L#=0
       LET  :EE:              DO LET
       $ENDIF
       $END